home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
TPUG - Toronto PET Users Group
/
TPUG Users Group CD
/
TPUG Users Group CD.iso
/
AMIGA
/
(A)TA
/
(A)TAP.ADF
/
CLICALC
/
calc.mod
< prev
Wrap
Text File
|
1987-02-03
|
7KB
|
318 lines
(*$S- don't check the stack *)
(*$T- turn off range checking *)
(* Developed using Modula-2/Amiga *)
(* TDI Software Inc. Dallas, Texas *)
(* Author: Robert Jones *)
(* Development Date: February 29, 1988 *)
(* Last Updated: April 24, 1988 *)
(* This program and its source code may be freely distributed in the *)
(* public domain. *)
(* To understand this program you should have an understanding of basic *)
(* arithmatical syntax. This program breaks down the input into its *)
(* component simple expression, term, and factor parts. *)
MODULE calc;
FROM Conversions IMPORT ConvertRealFromString;
FROM M2Conversions IMPORT ConvertReal;
FROM CommandLine IMPORT CLStrings, GetCL;
FROM Terminal IMPORT WriteString, WriteLn;
FROM MathLib0 IMPORT sin, cos, tan, arctan, exp, ln, log, sqrt, e, pi,
RadToDeg, DegToRad;
FROM Strings IMPORT Assign, Concat;
TYPE
StringType = ARRAY [0..79] OF CHAR;
ArgArrayType = ARRAY [0..15] OF CLStrings;
chset = SET OF CHAR;
CONST alphabet = chset {"A".."Z", "a".."z"}; (* not standard MODULA 2 *)
VAR
i, j, num: CARDINAL;
ArgArray: ArgArrayType;
result: REAL;
NoError: BOOLEAN;
StringAns, Equation, dummy: StringType;
(* =========================== StrCmp ============================= *)
PROCEDURE StrCmp (VAR s1: ARRAY OF CHAR; VAR s2: ARRAY OF CHAR): BOOLEAN;
(* StrCmp compares null terminated strings for equality. *)
VAR
i, j: CARDINAL;
BEGIN
j := 0;
i := 0;
WHILE (s1 [i] = s2 [i]) & ((s1 [i] # 0C) & (s2 [i] # 0C)) DO
INC (i);
INC (j);
END;
IF (s1 [i] # 0C) & (s2 [i] # 0C) THEN
RETURN FALSE
ELSE
RETURN TRUE;
END;
END StrCmp;
(* =========================== IsFunc =========================== *)
PROCEDURE IsFunc (VAR s: ARRAY OF CHAR; VAR FuncString: ARRAY OF CHAR;
VAR i: CARDINAL): BOOLEAN;
VAR
j, temp: CARDINAL;
BEGIN
j := 0;
temp := i;
FuncString [0] := 0C;
WHILE s [i] IN alphabet DO
FuncString [j] := s [i];
INC (j);
INC (i);
END;
IF ((s [i] <> "(") & NOT (s [i-1] IN alphabet)) OR
((StrCmp ("e", FuncString)) OR (StrCmp ("pi", FuncString))) THEN
i := temp;
RETURN FALSE
ELSE
FuncString [j] := 0C;
RETURN TRUE;
END;
END IsFunc;
(* ============================ EvalReal =========================== *)
PROCEDURE EvalReal (VAR s: ARRAY OF CHAR; VAR i: CARDINAL; VAR x: REAL;
VAR ok: BOOLEAN);
VAR
RealString: StringType;
ch: CHAR;
j: CARDINAL;
BEGIN
j := 0;
ch := s [i];
IF ch = "e" THEN
INC (i);
x := e;
RETURN
ELSIF (ch = "p") & (s [i+1] = "i") THEN
x := pi;
i := i + 2;
RETURN;
END;
WHILE (ch # 0C) & (ch # "+") & (ch # "-") &
(ch # "*") & (ch # "/") & (ch # ")") DO
RealString [j] := ch;
INC (i);
INC (j);
ch := s [i];
END;
RealString [j] := 0C;
ConvertRealFromString (x, RealString, ok);
END EvalReal;
(* ======================= EvalFunc =========================== *)
PROCEDURE EvalFunc (VAR s: ARRAY OF CHAR; VAR f: ARRAY OF CHAR;
VAR i: CARDINAL; VAR x: REAL; VAR ok: BOOLEAN);
(* This procedure evaluates the a mathematical function. I have designed
EvalFunc so that you can easily add your own functions. By looking at
the code you will see that you can call your new functions whatever you
want. I don't recommend changing the ones that CALC already knows. *)
BEGIN
simple (s, i, x, ok);
IF ok THEN
IF StrCmp ("sin", f) THEN
x := sin (x)
ELSIF StrCmp ("cos", f) THEN
x := cos (x)
ELSIF StrCmp ("tan", f) THEN
x := tan (x)
ELSIF StrCmp ("atn", f) THEN
x := arctan (x)
ELSIF StrCmp ("exp", f) THEN
x := exp (x)
ELSIF StrCmp ("ln", f) THEN
x := ln (x)
ELSIF StrCmp ("log", f) THEN
x := log (x)
ELSIF StrCmp ("sqrt", f) THEN
x := sqrt (x)
ELSIF StrCmp ("rad", f) THEN
x := RadToDeg (x)
ELSIF StrCmp ("deg", f) THEN
x := DegToRad (x)
ELSE
WriteString (f);
WriteString (" is an unimplemented function. ");
WriteString ("Result is incorrect.");
WriteLn;
END;
END;
IF s [i] <> ")" THEN
ok := FALSE;
END;
INC (i);
END EvalFunc;
(* ========================= simple ============================ *)
PROCEDURE simple (VAR s: ARRAY OF CHAR; VAR i: CARDINAL; VAR x: REAL;
VAR ok: BOOLEAN);
VAR
sign, ch: CHAR;
y: REAL;
BEGIN
sign := '+';
IF (s [i] = '+') OR (s [i] = '-') THEN
sign := s [i];
INC (i);
END;
term (s, i, x, ok);
IF (sign = '-') THEN
x := -x;
END;
ch := s [i];
WHILE ok & ((ch = '+') OR (ch = '-')) DO
INC (i);
term (s, i, y, ok);
IF ok THEN
IF ch = '+' THEN
x := x + y
ELSE
x := x - y;
END;
END;
ch := s[i];
END;
END simple;
(* ========================== term =========================== *)
PROCEDURE term (VAR s: ARRAY OF CHAR; VAR i: CARDINAL; VAR x: REAL;
VAR ok: BOOLEAN);
VAR
y: REAL;
ch: CHAR;
BEGIN
factor (s, i, x, ok);
ch := s [i];
WHILE ok & ((ch = '*') OR (ch = '/')) DO
INC (i);
factor (s, i, y, ok);
IF ok THEN
IF ch = '*' THEN
x := x * y
ELSE
x := x / y;
END;
END;
ch := s[i];
END;
END term;
(* ============================ factor =========================== *)
PROCEDURE factor (VAR s: ARRAY OF CHAR; VAR i: CARDINAL; VAR x: REAL;
VAR ok: BOOLEAN);
VAR f: StringType;
BEGIN
IF s [i] = '(' THEN
INC (i);
simple (s, i, x, ok);
IF ok THEN
IF s [i] # ')' THEN
ok := FALSE
ELSE
INC (i);
END;
END
ELSIF IsFunc (s, f, i) THEN
INC (i);
EvalFunc (s, f, i, x, ok)
ELSE
EvalReal (s, i, x, ok)
END;
END factor;
(* ============================ MAIN PROGRAM ========================== *)
BEGIN
i := 0;
NoError := TRUE;
result := 0.0;
IF NOT GetCL (num, ArgArray) THEN
WriteString ("Error getting command line");
WriteLn
ELSE
IF (num = 0) THEN
WriteString ("CALC version 2.0 - written by Bob Jones");
WriteLn;
WriteString ("USAGE: calc [expression]");
WriteLn
ELSE
IF num > 1 THEN
FOR j := 1 TO num DO
Concat (Equation, ArgArray [j-1], dummy);
Assign (Equation, dummy);
END
ELSE
Assign (Equation, ArgArray [0]);
END;
simple (Equation, i, result, NoError);
IF Equation [i] # 0C THEN
NoError := FALSE;
END;
IF NoError THEN
ConvertReal (result, 15, 6, StringAns);
WriteString (StringAns);
WriteLn
ELSE
WriteString ("Malformed expression: ");
WriteString (Equation);
WriteLn;
END;
END;
END;
END calc.